home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 9 / CDACTUAL9.iso / share / Dos / VARIOS / pascal / KEYBOARD.SWG / 0004_Toggle Special Keys.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1996-02-21  |  4.8 KB  |  197 lines

  1. {
  2.  JR> Does anyone have the code (probably ASM) to turn the CapsLock key of
  3.  JR> _and_ on as well?  Thanks in advance if you can help.
  4. }
  5.  
  6. Procedure TogLed (Lock: Integer);
  7.  
  8. Const
  9.      Num=1;
  10.      Caps=2;
  11.      Scroll=3;
  12.      AllOff=0;
  13.      AllOn=4;
  14.  
  15. Type
  16.     BitMapByte=Array[0..7] OF Boolean;
  17.  
  18.  
  19. Var
  20.   OldStatByte,
  21.   StatByte:  Byte;
  22.   StatMap:  BitMapByte;
  23.   OldTimerVec:  Pointer;
  24.  
  25. Label
  26.      Start,GetOne,Quit;
  27.  
  28. {****************************************************************}
  29. Procedure BitMap(ToConvert:  Byte;
  30.                  Var Converted:  BitMapByte);
  31.  
  32. Var Count:  Integer;
  33.     Temp:  Word;
  34.  
  35. Begin {Procedure BitMap}
  36.       For Count:=7 DownTo 0 DO
  37.           Begin {FOR Count}
  38.           Temp:=PowerX(2,Count);
  39.           If ToConvert>=Temp
  40.              Then
  41.              Begin {If ToConvert>=Temp}
  42.                  Converted[Count]:=True;
  43.                  ToConvert:=ToConvert-Temp
  44.              End   {If ToConvert>=Temp}
  45.              Else
  46.              Converted[Count]:=False
  47.           End {FOR Count}
  48. End;{Procedure BitMap}
  49. {****************************************************************}
  50. Procedure MapToByte(ToConvert:  BitMapByte;
  51.                     Var Converted:  Byte);
  52.  
  53. Var
  54.    Count:  Byte;
  55.  
  56. Begin {Procedure MapToByte}
  57.      Converted:=0;
  58.      For Count:=0 TO 7 Do
  59.          If ToConvert[Count]
  60.             Then
  61.             Converted:=Converted+PowerX(2,Count);
  62. End;  {Procedure MapToByte}
  63. {****************************************************************************}
  64. Begin {Procedure TogLed}
  65.      StatByte:=Mem[0:$417];
  66.      BitMap(StatByte,StatMap);
  67.      Case Lock Of
  68.           0: Begin
  69.                   StatMap[4]:=False;
  70.                   StatMap[5]:=False;
  71.                   StatMap[6]:=False
  72.              End;
  73.           1: Begin
  74.                   If StatMap[5]=True
  75.                      Then
  76.                      StatMap[5]:=False
  77.                      Else
  78.                      StatMap[5]:=True
  79.              End;
  80.           2: Begin
  81.                   If StatMap[6]=True
  82.                      Then
  83.                      StatMap[6]:=False
  84.                      Else
  85.                      StatMap[6]:=True
  86.              End;
  87.           3: Begin
  88.                   If StatMap[4]=True
  89.                      Then
  90.                      StatMap[4]:=False
  91.                      Else
  92.                      StatMap[4]:=True
  93.              End;
  94.           4: Begin
  95.                   StatMap[4]:=True;
  96.                   StatMap[5]:=True;
  97.                   StatMap[6]:=True
  98.              End;
  99.      End;
  100.      Asm
  101.         Start:
  102.         MOV AH,$05
  103.         MOV CH,$00
  104.         MOV CL,$00
  105.         INT $16
  106.         CMP AL,$1
  107.         JE  GetOne
  108.         JMP Quit
  109.         GetOne:
  110.         MOV AH,$00
  111.         INT $16
  112.         JMP Start
  113.         Quit:
  114.      End;
  115.      MapTOByte(StatMap,StatByte);
  116.      Mem[0:$417]:=StatByte;
  117.      Asm
  118.         MOV AH,$00
  119.         INT $16
  120.      End;
  121. End;  {Procedure TogLed}
  122.  
  123.  
  124.                  / -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- \
  125.                  | Steve_Schwarz@f1244.n141.z1.fidonet.org |
  126.                  |        SysOp: The RoadHouse BBS         |
  127.                  |  (203) 263-5922  -=Home of the blues=-  |
  128.                  \ -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- /
  129.  
  130. { ---------------------------------------------------------------- }
  131.  
  132. USES DOS,CRT;
  133.  
  134. Type
  135.  
  136.    Toggles      = (RShift, LShift, Ctrl, Alt,
  137.                    ScrollLock, NumLock, CapsLock, Insert);
  138.    Status       = Set of Toggles;
  139.  
  140. Const
  141.    ToggleStr   : Array[Toggles] OF String[10] = (
  142.                  'RShift','LShift','Ctrl','Alt',
  143.                  'Scroll','Num','Caps','Insert');
  144.  
  145. Var
  146.    KeyStatus   : Status Absolute $40:$17;
  147.    OldStatus   : Status;
  148.    Flip        : BOOLEAN;
  149.    T           : Toggles;
  150.  
  151.  
  152.    PROCEDURE RandomRoutine;
  153.    VAR
  154.         R,C : BYTE;
  155.    BEGIN
  156.    R := Random(24) + 1;
  157.    C := Random(79) + 1;
  158.    GoToXY(C,R);Write(ToggleStr[T]);
  159.    END;
  160.  
  161.  
  162.    PROCEDURE StatusFlasher ( D : BYTE);
  163.    BEGIN
  164.    WHILE NOT Keypressed DO
  165.       BEGIN
  166.         IF Flip THEN KeyStatus := KeyStatus + [T] ELSE
  167.                      KeyStatus := KeyStatus - [T];
  168.  
  169.         {  Call another routine here if you like }
  170.         RandomRoutine;
  171.  
  172.  
  173.         DEC(T);              { get the next toggle }
  174.         DELAY(D);            { delay this long }
  175.         Flip := NOT Flip;    { flip the on/off state }
  176.  
  177.         IF T = ALT THEN T := CapsLock;  { limit the list to just the three }
  178.  
  179.       END;
  180.    END;
  181.  
  182.  
  183. BEGIN
  184. CLRSCR;
  185. T         := Capslock;   { staring toggle          }
  186. OldStatus := KeyStatus;  { save the current Status }
  187. Flip      := TRUE;       { used to flip it off/on  }
  188.  
  189. StatusFlasher( 100 );           { the main procedure to make lights flash }
  190.  
  191. KeyStatus := OldStatus;  { restore original status }
  192.  
  193. END.
  194.  
  195. Martin Woods
  196. martin@nisa.net
  197.